home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
PsL Monthly 1993 December
/
PSL Monthly Shareware CD-ROM (December 1993).iso
/
prgmming
/
dos
/
pascal
/
shazam.exe
/
GDIALOG.IMP
< prev
next >
Wrap
Text File
|
1992-09-01
|
14KB
|
378 lines
{*******************************************************************
GDIALOG.IMP
*******************************************************************}
{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
DIALOG UTILITIES
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
{===================================================================
COPY DIALOG - Otherwise known as "reverse polymorphism"
===================================================================}
function CopyDialog ( DSource , DTarget : PDialog ) : boolean ;
{-------------------------------------------------------------------
ACTION
-------------------------------------------------------------------}
procedure Action ( P : PView ) ; FAR ;
begin
P^.Owner := DTarget ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
PROCESS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
var
R : TRect ;
begin
CopyDialog := FALSE ; { set flag }
if DSource = NIL then EXIT ; { nothing to do }
if DTarget = NIL then EXIT ; { nothing to do }
DSource^.GetBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
TARGET - change elements, then switch ownership.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DTarget^ do
begin
Dispose ( Frame , Done ) ; { free }
if Title <> NIL then
DisposeStr ( Title ) ; { free }
ChangeBounds ( R ) ; { extent }
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
COMPONENTS
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
Frame := DSource^.Frame ; { screen }
Title := DSource^.Title ; { screen }
Buffer := DSource^.Buffer ; { screen }
Next := DSource^.Next ; { sub-view }
Last := DSource^.Last ; { sub-view }
Current := DSource^.Current ; { sub-view }
Owner := DSource^.Owner ; { parent }
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
SOURCE - make sure we don't dispose stuff we need!
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
with DSource^ do
begin
Frame := NIL ; { screen }
Title := NIL ; { screen }
Buffer := NIL ; { screen }
Next := NIL ; { sub-view }
Last := NIL ; { sub-view }
Current := NIL ; { sub-view }
Owner := NIL ; { parent }
end ;
Dispose ( DSource , Done ) ; { dump original }
DTarget^.ForEach ( @Action ) ; { fields }
CopyDialog := TRUE ; { set flag }
end ;
{===================================================================
SCROLLBAR - Vertical, either side
===================================================================}
function AddVScrollBar ( G : PGroup ; Right : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Right then
begin
R.A := R.B ;
dec ( R.A.X ) ; { go left, to be visible }
dec ( R.B.Y ) ; { don't cover corner }
R.A.Y := 1 ; { don't cover corner }
end
else
begin
R.B.X := R.A.X + 1 ; { go right, to be visible }
R.A.Y := 1 ; { don't cover corner }
dec ( R.B.Y ) ; { don't cover corner }
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddVScrollBar := SB ;
end ;
{===================================================================
SCROLLBAR - Horizontal, top or bottom
===================================================================}
function AddHScrollBar ( G : PGroup ; Bottom : boolean ) : PScrollBar ;
var
R : TRect ;
SB : PScrollBar ;
begin
G^.GetExtent ( R ) ;
if Bottom then
begin
R.A.Y := R.B.Y - 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ; { don't cover corner }
end
else
begin
R.B.Y := R.A.Y + 1 ;
R.A.X := 1 ;
dec ( R.B.X ) ;
end ;
New ( SB , Init ( R ) ) ;
G^.Insert ( SB ) ;
AddHScrollBar := SB ;
end ;
{===================================================================
COUNT - Views which can hold data (non-static).
===================================================================}
function TActiveCount ( D : PDialog ) : byte ;
var
x : byte ;
procedure DoThis ( P : PView ) ; FAR ;
begin
if P^.DataSize = 0 then EXIT ;
inc ( x ) ;
end ;
begin
x := 0 ;
D^.ForEach ( @DoThis ) ;
TActiveCount := x ;
end ;
{===================================================================
Return pointer to view with data.
===================================================================}
function DataRecPtr ( D : PDialog ; Fnum : byte ) : pointer ;
var
x : byte ;
{-------------------------------------------------------------------
-------------------------------------------------------------------}
function DoThis ( P : PView ) : boolean ; FAR ;
var
S : string ;
begin
DoThis := FALSE ;
if P^.DataSize = 0 then EXIT ;
dec ( x ) ;
if x <> Fnum then EXIT ;
DoThis := TRUE ;
end ;
{- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
begin
DataRecPtr := NIL ;
x := TActiveCount ( D ) + 1 ;
if FNum > x then EXIT ;
DataRecPtr := D^.FirstThat ( @DoThis ) ;
end ;
{===================================================================
SET - Reference View's data by view order number.
===================================================================}
procedure SetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.SetData ( Data^ ) ;
P^.DrawView ;
end ;
{===================================================================
GET - Reference View's data by view order number.
===================================================================}
procedure GetDataRec ( D : PDialog ; Fnum : byte ; Data : pointer ) ;
var
P : PView ;
begin
P := DataRecPtr ( D , Fnum ) ;
if P = NIL then EXIT ;
P^.GetData ( Data^ ) ;
end ;
{===================================================================
BUTTON ON/OFF
===================================================================}
procedure SetButtons ( D : PDialog ; On : boolean ) ;
procedure DoThis ( P : PView ) ; FAR ;
begin
if TypeOf ( P^ ) <> TypeOf ( TButton ) then EXIT ;
if On then
P^.Show